﻿' ------------------------------------------------------------------------------
' This class is provides many high-level mapping functions using the
' Dundas map control for map display. It has methods for manipulating
' map layers, setting the map extent, and converting a limited set of
' sql geography and geometry types to their Dundas map equivalents.
'
' Several issues arose during the limited time available to add the
' Dundas map control to the application. These have been resolved mostly
' by brute force solutions.
'
' Issues include:
'
' - When does the map update? Does it need to be refreshed by the
'   client?
'
' - How can features be flashed?
'
' - The map extent's coordinate retrieved from the control does not
'   always correspond to the limits of the map being shown.
'
' - Why does the map update so slowly?
'
' - The binary map file has color rendition problems that cause some
'   features to be colored differently than the XML versions of the
'   same map.
'
' This code is to be considered preliminary or disposable -- it works,
' with poor performance, and could use some serious refactoring,
' generalization, and rationalization.
' ------------------------------------------------------------------------------
' This file is part of the SQL Server 2008 Technology Demonstration. This
' application was designed and coded by Eric Weitzman, LandTime Inc, for
' Microsoft Corporation. Contact Ed Katibah at Microsoft about this demo.
' Copyright © 2008 Microsoft Corporation. All rights reserved.
' ------------------------------------------------------------------------------

Imports Dundas.Maps.WinControl

Public Class DundasMapVeneer

    Private m_map As MapControl
    Shared m_id As Integer = 0

    Const DEFAULT_EXPAND_EXTENT As Double = 2.0
    Const MIN_WIDTH As Double = 2.0
    Const MIN_HEIGHT As Double = 2.0

    Public Enum EnumExtent
        eWorld
        eCONUS
        eNorthAmerica
    End Enum

    Public Sub New(ByVal map As MapControl)
        m_map = map
    End Sub

    Public ReadOnly Property Map() As MapControl
        Get
            Return m_map
        End Get
    End Property

    Public Sub LoadMap(ByVal debug As Boolean)

        'm_map.Serializer.Format = SerializationFormat.Binary
        'm_map.Serializer.Load(My.Resources.basemap_binary_path)
        m_map.Serializer.Format = SerializationFormat.Xml
        m_map.Serializer.Load(My.Settings.RTS_BasemapXml)

        If m_map.Legends.Count > 0 Then
            For i As Integer = m_map.Legends.Count - 1 To 0
                m_map.Legends.RemoveAt(i)
            Next
        End If

        m_map.NavigationPanel.Visible = True
        m_map.NavigationPanel.Size.Width = 50
        m_map.NavigationPanel.Size.Height = 50
        m_map.NavigationPanel.PanelStyle = NavigationPanelStyle.TriangularButtons
        m_map.NavigationPanel.Location.X = 0
        m_map.NavigationPanel.Location.Y = 0
        m_map.NavigationPanel.BackColor = Nothing

        m_map.ZoomPanel.Visible = True
        m_map.ZoomPanel.Location.X = 12
        m_map.ZoomPanel.Location.Y = 55
        m_map.ZoomPanel.Size.Width = 25
        m_map.ZoomPanel.Size.Height = 200
        m_map.ZoomPanel.PanelStyle = ZoomPanelStyle.RectangularButtons
        m_map.ZoomPanel.BackColor = Nothing

        m_map.DistanceScalePanel.Visible = False

        m_map.KeyboardNavigation = True
        m_map.MouseWheelZooming = True

        m_map.Parallels.Visible = False
        m_map.Meridians.Visible = False

        m_map.Projection = Projection.Equirectangular

        For Each shape As Shape In m_map.Shapes
            If shape.Layer = "Countries" Then
                shape.Text = ""
                shape.BorderStyle = MapDashStyle.Solid
                If debug Then
                    shape.Color = Color.FromArgb(0)
                    shape.BorderColor = Color.LightGray
                Else
                    shape.Color = Color.CadetBlue
                    shape.BorderColor = Color.Gray
                End If
            End If
        Next

        If debug Then
            HideLayer("Rivers")
            HideLayer("Lakes")
        End If

    End Sub

    Public Sub ShowLayer(ByVal layername As String)
        Dim i As Integer = m_map.Layers.GetIndex(layername)
        If i = -1 Then Return
        m_map.Layers.Item(i).Visibility = LayerVisibility.Shown
    End Sub

    Public Sub HideLayer(ByVal layername As String)
        Dim i As Integer = m_map.Layers.GetIndex(layername)
        If i = -1 Then Return
        m_map.Layers.Item(i).Visibility = LayerVisibility.Hidden
    End Sub

    Public Sub LoadLayer(ByVal layername As String, ByVal dt As DataTable, ByVal spatialcolumn As Integer)
        ClearLayer(layername)
        If dt.Rows.Count = 0 Then Return

        If m_map.Layers.GetIndex(layername) = -1 Then m_map.Layers.Add(layername)

        ' check the type of the first geography, assume the rest are the same
        Dim g As SqlGeography = DirectCast(dt.Rows.Item(0).Item(spatialcolumn), SqlGeography)
        If g.InstanceOf("Point").Value Then
            For Each row As DataRow In dt.Rows
                g = DirectCast(row.Item(spatialcolumn), SqlGeography)
                Dim symbol As Symbol = SqlGeographyPointToSymbol(g)

                symbol.MarkerStyle = MarkerStyle.Rectangle
                symbol.Width = 8
                symbol.Height = 8
                If layername = "OutPhoto" Then
                    symbol.Color = Color.DimGray
                Else
                    symbol.Color = Color.Red
                End If

                symbol.BorderColor = Color.White
                symbol.BorderWidth = 1

                m_id += 1
                symbol.Name = layername & m_id.ToString
                symbol.Layer = layername

                m_map.Symbols.Add(symbol)
            Next

        ElseIf g.InstanceOf("Polygon").Value Or g.InstanceOf("MultiPolygon").Value Then
            For Each row As DataRow In dt.Rows
                g = DirectCast(row.Item(spatialcolumn), SqlGeography)

                Dim shape As Shape = SqlGeographyPolygonToShape(g)
                shape.BorderWidth = 1
                shape.BorderColor = Color.DarkGoldenrod
                shape.BorderStyle = MapDashStyle.Solid
                shape.Color = Nothing

                m_id += 1
                shape.Name = layername & m_id.ToString
                shape.Text = row.Item(0).ToString
                shape.Layer = layername

                m_map.Shapes.Add(shape)
            Next
        End If

    End Sub


    Public Sub ClearLayer(ByVal layername As String)

        ' this is probably all very inefficient

        Dim shapelist As New List(Of Shape)
        For Each shp As Shape In m_map.Shapes
            If shp.Layer = layername Then shapelist.Add(shp)
        Next
        For Each shp As Shape In shapelist
            m_map.Shapes.Remove(shp)
        Next

        Dim symbollist As New List(Of Symbol)
        For Each sym As Symbol In m_map.Symbols
            If sym.Layer = layername Then symbollist.Add(sym)
        Next
        For Each sym As Symbol In symbollist
            m_map.Symbols.Remove(sym)
        Next

        Dim pathlist As New List(Of Path)
        For Each p As Path In m_map.Paths
            If p.Layer = layername Then pathlist.Add(p)
        Next
        For Each p As Path In pathlist
            m_map.Paths.Remove(p)
        Next

        Trace.WriteLine("cleared layer: " & layername & vbTab & shapelist.Count & "/" & symbollist.Count & "/" & pathlist.Count)

    End Sub

    Public Sub LoadTimeZones(ByVal labels As Boolean, ByVal debug As Boolean)

        Static c0 As Color = Color.FromArgb(32, 0, 0, 0)
        Static c1 As Color = Color.FromArgb(48, 0, 0, 0)
        Static c2 As Color = Color.FromArgb(128, Color.Chartreuse.R, Color.Chartreuse.G, Color.Chartreuse.B)
        Static tzfont As Font = New System.Drawing.Font("Microsoft Sans Serif", 10, FontStyle.Bold, GraphicsUnit.Point, CType(0, Byte))

        For Each tz As SpatialAlbum.Core.TimeZone In SpatialAlbum.Core.TimeZone.GetTimeZones(g_connection).Values


            If debug And tz.CivTimeZoneCode.Trim() <> "CCT" Then Continue For

            Dim geom As SqlGeometry = tz.TimeZonePolygon
            If Not geom.STIsValid().Value Then geom = geom.MakeValid()
            Dim g As SqlGeometry = geom.Reduce(0.5F)

            Dim shape As Shape = SqlGeometryPolygonToShape(g)
            If shape Is Nothing Then Continue For

            shape.BorderStyle = MapDashStyle.None
            If debug Then
                shape.BorderColor = Color.Red
            Else
                shape.BorderColor = Nothing
            End If

            ' ColorIDs in the TimeZone table were set by hand so the timezone colors 
            ' would alternate every 15 degrees of longitude in spite of intervening
            ' odd shaped time zones

            If debug Then
                shape.Color = Nothing
            Else
                Select Case tz.ColorID
                    Case 1, -1 : shape.Color = c0
                    Case 2, -2 : shape.Color = c1
                    Case Else : shape.Color = c2
                End Select
            End If

            shape.Name = tz.UniqueID.ToString()
            shape.Layer = "TimeZone"

            If labels Then
                'shape.Text = shape.Name & "/" & ngeometries & "/" & nholes & "/" & npoints & "/" & tz.CivTimeZoneCode & "/" & tz.TimeZoneCode
                'shape.Text = shape.Name & "/" & tz.TimeZoneCode
                Dim text As String = ""
                If tz.CivTimeZoneCode.Trim <> "" Then
                    text = tz.CivTimeZoneCode.Trim
                ElseIf tz.TimeZoneCode.Trim <> "" Then
                    text = tz.TimeZoneCode.Trim
                End If
                If text <> "" Then text += vbCrLf
                text += tz.UtcOffset.ToString
                shape.Text = text
                shape.TextShadowOffset = 2
                shape.TextColor = Color.NavajoWhite
                shape.Font = tzfont
            Else
                shape.Text = ""
            End If

            m_map.Shapes.Add(shape)
        Next

    End Sub

    Public Function SqlGeometryPolygonToShape(ByVal g As SqlGeometry) As Shape
        Dim ngeometries As Integer = 0 : If Not g.STNumGeometries().IsNull Then ngeometries = g.STNumGeometries().Value
        Dim nholes As Integer = 0 : If Not g.STNumInteriorRing().IsNull Then nholes = g.STNumInteriorRing().Value
        Dim npoints As Integer = 0 : If Not g.STNumPoints().IsNull Then npoints = g.STNumPoints().Value
        If ngeometries = 0 Then Return Nothing
        If npoints = 0 Then Return Nothing

        Dim segs(ngeometries - 1) As ShapeSegment
        Dim points(npoints - 1) As MapPoint

        Dim np As Integer = 0
        For i As Integer = 0 To g.STNumGeometries.Value - 1
            Dim gpart As SqlGeometry = g.STGeometryN(i + 1)
            Dim gpartnpoints As Integer = gpart.STNumPoints.Value
            segs(i).Type = SegmentType.Polygon
            segs(i).Length = gpartnpoints
            For j As Integer = 0 To gpartnpoints - 1
                points(np).X = gpart.STPointN(j + 1).STX.Value
                points(np).Y = gpart.STPointN(j + 1).STY.Value
                np += 1
            Next
        Next
        Dim shape As New Shape
        shape.AddSegments(points, segs)
        Return shape
    End Function

    Public Function SqlGeographyPolygonToShape(ByVal g As SqlGeography) As Shape

        ' valid args for InstanceOf are
        ' Geometry, Point, Curve, LineString, Surface, Polygon, GeometryCollection, 
        ' MultiSurface, MultiPolygon, MultiCurve, MultiLineString, MultiPoint
        Assert(g.InstanceOf("Polygon").Value Or g.InstanceOf("MultiPolygon").Value, "SqlGeography instance is not a polygon")

        Dim ngeometries As Integer = 0 : If Not g.STNumGeometries().IsNull Then ngeometries = g.STNumGeometries().Value
        Dim nholes As Integer = 0 : If Not g.NumRings().IsNull Then nholes = g.NumRings().Value
        Dim npoints As Integer = 0 : If Not g.STNumPoints().IsNull Then npoints = g.STNumPoints().Value
        If ngeometries = 0 Then Return Nothing
        If npoints = 0 Then Return Nothing

        Dim segs(ngeometries - 1) As ShapeSegment
        Dim points(npoints - 1) As MapPoint

        Dim np As Integer = 0
        For i As Integer = 0 To g.STNumGeometries.Value - 1
            Dim gpart As SqlGeography = g.STGeometryN(i + 1)
            Dim gpartnpoints As Integer = gpart.STNumPoints.Value
            segs(i).Type = SegmentType.Polygon
            segs(i).Length = gpartnpoints
            For j As Integer = 0 To gpartnpoints - 1
                points(np).X = gpart.STPointN(j + 1).Long.Value
                points(np).Y = gpart.STPointN(j + 1).Lat.Value
                np += 1
            Next
        Next
        Dim shape As New Shape
        shape.AddSegments(points, segs)
        Return shape
    End Function

    Public Function SqlGeographyPointToSymbol(ByVal g As SqlGeography) As Symbol
        Assert(g.InstanceOf("Point").Value, "SqlGeography instance is not a point")
        Dim symbol As New Symbol
        symbol.X = g.STStartPoint().Long.Value
        symbol.Y = g.STStartPoint().Lat.Value
        Return symbol
    End Function

    Public Sub AddPhoto(ByVal point As LatLong, Optional ByVal highlight As Boolean = False)

        If highlight Then
            For Each s As Symbol In m_map.Symbols
                If s.Layer = "TimeZone" Then s.Color = Color.Gray
            Next
        End If

        Dim symbol As New Symbol
        symbol.MarkerStyle = MarkerStyle.Rectangle
        symbol.Width = 8
        symbol.Height = 8
        symbol.X = New MapCoordinate(point.Long)
        symbol.Y = New MapCoordinate(point.Lat)
        symbol.Color = Color.Red
        symbol.BorderColor = Color.White
        symbol.BorderWidth = 1
        symbol.Layer = "TimeZone"
        m_map.Symbols.Add(symbol)

        m_map.Update()
    End Sub

    Public Sub ShowSqlGeography(ByVal layername As String, ByVal geog As SqlGeography, ByVal buffer As SqlGeography, Optional ByVal text As String = "", Optional ByVal clear As Boolean = False)
        If clear Then ClearLayer(layername)
        If buffer Is Nothing Then
            Select Case geog.STDimension.Value
                Case 0 : ShowSqlGeographyPoint(layername, geog, text)
                Case 1 : ShowSqlGeographyLine(layername, geog, text)
                Case 2 : ShowSqlGeographyPolygon(layername, geog, text)
            End Select
        Else
            Select Case geog.STDimension.Value
                Case 0 : ShowSqlGeographyPoint(layername, geog, text)
                Case 1 : ShowSqlGeographyLine(layername, geog, text)
                Case 2 : ShowSqlGeographyPolygon(layername, geog, text, 1)
            End Select
            Select Case buffer.STDimension.Value
                Case 0 : ShowSqlGeographyPoint(layername, buffer, "")
                Case 1 : ShowSqlGeographyLine(layername, buffer, "")
                Case 2 : ShowSqlGeographyPolygon(layername, buffer, "")
            End Select
        End If
        m_map.Update()
    End Sub

    Private Sub ShowSqlGeographyPoint(ByVal layername As String, ByVal geog As SqlGeography, ByVal text As String)
        Dim symbol As Symbol = SqlGeographyPointToSymbol(geog)

        symbol.MarkerStyle = MarkerStyle.Star
        symbol.Width = 15
        symbol.Height = 15
        symbol.Color = Color.Red
        symbol.BorderColor = Color.White
        symbol.BorderWidth = 1

        m_id += 1
        symbol.Name = layername & m_id.ToString
        symbol.Text = text
        symbol.TextAlignment = TextAlignment.Right
        symbol.Font = New System.Drawing.Font(m_map.Font, FontStyle.Bold)
        symbol.TextShadowOffset = 2
        symbol.Layer = layername

        If m_map.Layers.GetIndex(layername) = -1 Then m_map.Layers.Add(layername)

        m_map.Symbols.Add(symbol)
        SetMapExtent(symbol)
    End Sub

    Private Sub ShowSqlGeographyLine(ByVal layername As String, ByVal geog As SqlGeography, ByVal text As String)
    End Sub

    Private Sub ShowSqlGeographyPolygon(ByVal layername As String, ByVal geog As SqlGeography, ByVal text As String, Optional ByVal borderwidth As Integer = 3)
        Dim shape As Shape = SqlGeographyPolygonToShape(geog)

        shape.BorderStyle = MapDashStyle.Solid
        shape.BorderColor = Color.Red
        shape.BorderWidth = borderwidth
        shape.Color = Nothing

        m_id += 1
        shape.Name = layername & m_id.ToString
        shape.Text = text
        shape.Layer = layername

        If m_map.Layers.GetIndex(layername) = -1 Then m_map.Layers.Add(layername)

        m_map.Shapes.Add(shape)
        SetMapExtent(shape)
    End Sub

    Private m_oldcolor As Color
    Private m_highlight_shape As Shape = Nothing

    ' Flashing is accomplished by changing the shape's color.
    ' The old color is restored when the client calls ClearHighlights().
    ' A timer-based implementation would be better...

    Public Sub FlashShape(ByVal s As Shape)

        If m_highlight_shape IsNot Nothing Then
            m_highlight_shape.Color = m_oldcolor
            m_map.Update()
            My.Application.DoEvents()
        End If

        m_oldcolor = s.Color
        m_highlight_shape = s

        s.Color = Color.FromArgb(192, Color.DeepSkyBlue.R, Color.DeepSkyBlue.G, Color.DeepSkyBlue.B)
        m_map.Update()

    End Sub

    Public Sub ClearHighlights()
        If m_highlight_shape Is Nothing Then Return
        m_highlight_shape.Color = m_oldcolor
        m_highlight_shape = Nothing
        m_map.Update()
    End Sub

    Public Sub SetMapExtent(ByVal ext As EnumExtent)
        Select Case ext
            Case EnumExtent.eWorld
                SetMapExtent(-180, -90, 180, 90)
                m_map.Projection = Projection.Equirectangular
            Case EnumExtent.eCONUS
                SetMapExtent(-130, 25, -60, 45)
                m_map.Projection = Projection.Robinson
                'm_map.Projection = Projection.Equirectangular
            Case EnumExtent.eNorthAmerica
                SetMapExtent(-160, 15, -60, 90)
                m_map.Projection = Projection.Eckert1
        End Select
        m_map.ProjectionCenter.X = (m_map.MapLimits.MinimumX + m_map.MapLimits.MaximumX) / 2
        m_map.ProjectionCenter.Y = (m_map.MapLimits.MinimumY + m_map.MapLimits.MaximumY) / 2
    End Sub

    Public Sub SetMapExtent(ByVal minx As Double, ByVal miny As Double, ByVal maxx As Double, ByVal maxy As Double)
        m_map.MapLimits.MinimumX = minx
        m_map.MapLimits.MinimumY = miny
        m_map.MapLimits.MaximumX = maxx
        m_map.MapLimits.MaximumY = maxy
    End Sub

    Public Sub SetMapExtent(ByVal s As Shape, Optional ByVal expand As Double = 0.0)
        Dim minx As Double = s.ShapeData.MinimumExtent.X
        Dim miny As Double = s.ShapeData.MinimumExtent.Y
        Dim maxx As Double = s.ShapeData.MaximumExtent.X
        Dim maxy As Double = s.ShapeData.MaximumExtent.Y

        ' BUG: this check to avoid panning if the shape is in the map extent doesn't always work.
        ' Try Colorado then Kansas: MapLimits shows Kansas partly outside map extent but it isn't.
        ' Probably MapControl.MapLimits reflects the values set, not the actual values after
        ' adjusted internally for the aspect ratio and/or being manipulated by the user.

        'If m_map.MapLimits.MinimumX <= minx And m_map.MapLimits.MinimumY <= miny And _
        '   m_map.MapLimits.MaximumX >= maxx And m_map.MapLimits.MaximumY >= maxy Then Return

        Dim cenx As Double = (minx + maxx) / 2.0
        Dim ceny As Double = (miny + maxy) / 2.0
        If expand <= 0.0 Then expand = DEFAULT_EXPAND_EXTENT
        Dim dx As Double = expand * ((maxx - minx) / 2.0)
        Dim dy As Double = expand * ((maxy - miny) / 2.0)

        dx = Math.Max(dx, MIN_WIDTH / 2.0)
        dy = Math.Max(dy, MIN_HEIGHT / 2.0)

        minx = cenx - dx
        maxx = cenx + dx
        miny = ceny - dy
        maxy = ceny + dy
        SetMapExtent(minx, miny, maxx, maxy)
    End Sub

    Public Sub SetMapExtent(ByVal symbol As Symbol)
        Dim x As Double = symbol.X.ToDouble
        Dim y As Double = symbol.Y.ToDouble

        ' See bug noted in SetMapExtent
        'If m_map.MapLimits.MinimumX <= x And m_map.MapLimits.MinimumY <= y And _
        '   m_map.MapLimits.MaximumX >= x And m_map.MapLimits.MaximumY >= y Then Return
        SetMapExtent(x - MIN_WIDTH / 2.0, _
                     y - MIN_HEIGHT / 2.0, _
                     x + MIN_WIDTH / 2.0, _
                     y + MIN_HEIGHT / 2.0)
    End Sub

    Public Function MapExtentAsWKT(ByVal order As EnumCoordinateOrder) As String

        Dim minx As Double = m_map.MapLimits.MinimumX
        Dim miny As Double = m_map.MapLimits.MinimumY
        Dim maxx As Double = m_map.MapLimits.MaximumX
        Dim maxy As Double = m_map.MapLimits.MaximumY

        Dim sb As New System.Text.StringBuilder
        sb.Append("POLYGON((")
        If order = EnumCoordinateOrder.eLongitudeLatitude Then
            sb.Append(minx).Append(" ").Append(miny).Append(", ")
            sb.Append(minx).Append(" ").Append(maxy).Append(", ")
            sb.Append(maxx).Append(" ").Append(maxy).Append(", ")
            sb.Append(maxx).Append(" ").Append(miny).Append(", ")
            sb.Append(minx).Append(" ").Append(miny)
        Else
            sb.Append(miny).Append(" ").Append(minx).Append(", ")
            sb.Append(miny).Append(" ").Append(maxx).Append(", ")
            sb.Append(maxy).Append(" ").Append(maxx).Append(", ")
            sb.Append(maxy).Append(" ").Append(minx).Append(", ")
            sb.Append(miny).Append(" ").Append(minx)
        End If
        sb.Append("))")
        Return sb.ToString
    End Function

End Class
